## !!!! REPLICATION NOTE:
## THESE FILES DO NOT RUN ON THEIR OWN; THEY SIMPLY CONTAIN FUNCTIONS

## c:/Dropbox/Rpackages/starpolish/R/star_panel.R

##    Chandler Lutz
##    Questions/comments: cl.eco@cbs.dk
##    $Revisions:      1.0.0     $Date:  2016-12-19


#' To get a panel of stargazer output
#'
#' Currently only the same lhs variables and
#' the same summary statistics across all panels are allowed
#'
#' @param ... \code{stargazer} output
#' @param starlist a list of \code{stargazer} output
#' @param panel.names the names for the panels in the same order as
#'     the stargazer output
#' @param reg (logical) set to TRUE if the panels are regression
#'     output; defualt is TRUE
#' @param same.lhs.vars (logical) set to \code{TRUE} if all panels
#'     have the same left-hand-side variables. Currently, only
#'     \code{TRUE} is supported
#' @param same.summary.stats (logical) set to \code{TRUE} if all
#'     panels have the same summary stats. Default is \code{TRUE}. If
#'     set to \code{FALSE}, different panels can have different
#'     summary stats. \code{same.summary.stats = FALSE} is only
#'     supported for regression and so \code{reg} must be set to
#'     \code{TRUE}
#' @param panel.label.fontface The fontface for the panel
#'     labels. Options are "plain", "italic", "bold",
#'     "bold.italic". Default is "plain".
#' @return the updated \code{stargazer} output
#' @examples
#' ## -- Regressoin example -- ##
#' library(stargazer)
#' data(mtcars)
#' ##First set up models without weight
#' mod.mtcars.1 <- lm(mpg ~ hp, mtcars)
#' mod.mtcars.2 <- lm(mpg ~ hp + cyl, mtcars)
#' star.out.1 <- stargazer(mod.mtcars.1, mod.mtcars.2, keep.stat = "n")
#' ##Second set of models with weight as a regressor
#' mod.mtcars.3 <- lm(mpg ~ hp + wt, mtcars)
#' mod.mtcars.4 <- lm(mpg ~ hp + cyl + wt, mtcars)
#' star.out.2 <- stargazer(mod.mtcars.3, mod.mtcars.4, keep.stat = c("n", "rsq"))
#'
#' ##stargazer panel -- same summary statistics across panels.
#' star.panel.out <- star_panel(star.out.1, star.out.2,
#'                              panel.names = c("Without Weight", "With Weight")
#'                             )
#' print(star.panel.out)
#' ##write to a tex file and compile to check output
#' \dontrun{
#' tex_write(star.panel.out, file = "my_tex_file.tex", headers = TRUE)
#' }
#'
#' ##stargazer panel -- different summary statistics across panels.
#' star.panel.out2 <- star_panel(star.out.1, star.out.2,
#'                               same.summary.stats = FALSE,
#'                               panel.names = c("Without Weight", "With Weight")
#'                              )
#' print(star.panel.out2)
#' ##write to a tex file and compile to check output
#' \dontrun{
#' tex_write(star.panel.out2, file = "my_tex_file2.tex", headers = TRUE)
#' }
#' @export
star_panel <- function(..., starlist = NULL, panel.names,
                       reg = TRUE, same.lhs.vars = TRUE,
                       same.summary.stats = TRUE, extra.rows,
                       panel.label.fontface = "plain") {
  
  ##Get all of the star output
  if (is.null(starlist)) starlist <- c(list(...))
  latex <- is.latex(starlist[[1]])
  text <- is.text(starlist[[1]])
  
  if (!latex) stop("Currently only latex supported")
  
  if (length(panel.names) != length(starlist)) {
    stop("the length of panel.names needs to be the same as the length of starlist")
  }
  
  ##Get the panel names using letters
  for (i in seq_along(panel.names)) {
    ##Update the panel name
    panel.names[i] <- paste0("\\textbf{Panel ", LETTERS[i], ": ", panel.names[i],"}") #TK SOC changed here for patex bolding of panel titles
  }
  
  ##Now get the star lines
  star.lines <- lapply(starlist, get_star_lines, reg = reg, extra.rows=extra.rows)
  
  ##The starting and ending lines
  start.lines <- star.lines[[1]]$start.lines
  
  
  ##Initialize the summary statistics for each panel to NULL
  panel.summary.stats <- vector(mode = "list",
                                length = length(starlist))
  
  ##Only regressions are allowed to have different
  ##summary stats across panels
  if (same.summary.stats == FALSE && reg == TRUE) {
    ##Get the end lines without any summary stats. The
    ##end lines will be from the second hline to the end,
    ##after the summary stats
    end.lines <- star.lines[[1]]$end.lines
    end.lines.second.hline <- grep("hline", end.lines)[2]
    end.lines <- end.lines[end.lines.second.hline:length(end.lines)]
    
    ##Loop through the starlist and add the summary stats
    ##Use a cline before each set of summary stats
    for (i in seq_along(panel.summary.stats)) {
      ##the end lines
      out <- star.lines[[i]]$end.lines
      ##The summary stats will be between the first and second hlines
      out.hlines <- grep("hline", out)
      
      ##The summary statistics TK SOC CHANGED THIS LINE FROM ORIGINAL for APSR format with extra hlines and only one kept regressor
      out <- out[(out.hlines[1]+1):(out.hlines[2]-1)]
      
      ##Add in a cline before the summary stats
      out <- c(paste0("\\cline{2-", star_ncol(out), "} \\\\[-2.0ex]"),
               out)
      
      ##For the bottom panel, add a little space after
      ##the summary stats
      if (i == length(panel.summary.stats))
        out <- c(out, "\\\\[-2.0ex]")
      
      ##Assign the output
      panel.summary.stats[[i]] <- out
      
      ##remove out
      rm(out, out.hlines)
    }
    
  } else {
    ##If the summary statistics are the same across all panels,
    ##use the summary statistics from the first panel
    end.lines <- star.lines[[1]]$end.lines
    
  }
  
  
  ##Get just the main lines
  star.lines <- lapply(star.lines, function(x) x$main.lines)
  
  ##Add the panel names at the top of the main lines
  for (i in seq_along(starlist)) {
    
    ##The temporary panel name
    ##note: add @{} to left alignment as stargazer adds
    ##extra line space. see http://tex.stackexchange.com/a/276468/16412
    temp.panel.name <- paste0("\\\\[-2.0ex] \\multicolumn{",
                              star_ncol(star.lines[[i]]),
                              ##make sure to add an empty column after the
                              ##panel name
                              "}{@{} l}{")
    ##Add in the panel name with the fontface requested by the user
    if (panel.label.fontface == "plain") {
      temp.panel.name <- paste0(temp.panel.name, panel.names[i], "}")
    } else if (panel.label.fontface == "bold") {
      temp.panel.name <- paste0(temp.panel.name, "\\textbf{", panel.names[i], "}}")
    } else if (panel.label.fontface == "italic") {
      temp.panel.name <- paste0(temp.panel.name, "\\textit{", panel.names[i], "}}")
    } else if (panel.label.fontface == "bold.italic") {
      temp.panel.name <- paste0(temp.panel.name,
                                "\\textit{\\textbf{", panel.names[i], "}}}")
    } else {
      stop('temp.panel.name must be "plain", "bold", "italic", or "bold.italic')
    }
    
    ##Finish the line and add a little space
    temp.panel.name <- paste0(temp.panel.name, "\n \\\\",
                              "\n \\\\[-1.5ex]")
    
    ##If not the last panel, add the hline and a little
    ##space after. Otherwise, add nothing
    if (i != length(panel.names)) {
      ##
      hline.end <- "\\\\[-1.83ex] \n \\hline \\\\[-1.83ex]"
    } else {
      hline.end <- NULL
    }
    
    ##If there are going to be different summary statistics
    ##for each panel, add them in
    
    star.lines[[i]] <- c(temp.panel.name,
                         star.lines[[i]],
                         panel.summary.stats[[i]], ##Add in the panel summ stats
                         hline.end
    )
    
  }
  
  out <- c(start.lines, unlist(star.lines), end.lines)
  
  return(out)
  
}



##    Chandler Lutz
##    Questions/comments: cl.eco@cbs.dk
##    $Revisions:      1.0.0     $Date:  2016-12-20

##for functions to write to a tex file


#' Create the start of a tex
#'
#' @param file a \code{string} with the file name
#' @export
star_tex_start <- function(file) {
  
  ##the lines to write
  temp.lines <- paste0("%% ", file, "\n",
                       "\\documentclass[a4paper,12pt]{article}",
                       "\n",
                       "\\usepackage{caption}\n",
                       "\\usepackage{siunitx}\n",
                       "\\usepackage{rotating}\n",
                       "\\usepackage{natbib}\n",
                       "\\usepackage[flushleft]{threeparttable}",
                       "\\usepackage[a4paper, hmargin=0.5in,vmargin=0.5in]{geometry}",
                       "\\begin{document}",
                       "\n")
  ##write
  write(temp.lines, file, append = FALSE)
  return(invisible(NULL))
}

#' Create the end of a tex document
#'
#' @param file a \code{character} string with the file name
#' @param append append to the end of a tex file; defaults to TRUE
#' @export
star_tex_end <- function(file, append = TRUE) {
  
  ##the lines to write
  temp.lines <- c("\n\n \\end{document}")
  
  write(temp.lines, file, append = append)
}


#' Write a stargazer output to a tex file
#'
#' @param ... stargazer ouptut
#' @param starlist a list of stargazer output to write to a file
#' @param file where the file will be saved
#' @param headers (logical) to include the start of a tex afile
#' @param append logical to append at the end of a tex file; defaults
#' to \code{FALSE}
#' @export
star_tex_write <- function(..., starlist = NULL, file, headers = FALSE, append = FALSE) {
  
  ##Get all of the output in a list
  starlist <- c(list(...), starlist)
  
  ##remove the information on the stargazer package author
  starlist <- lapply(starlist, function(x) x[!grepl("% Table created by", x)])
  
  top.header <- paste0("%% ", file, "\n",
                       "\\documentclass[a4paper,12pt]{article}",
                       "\n",
                       "\\usepackage{caption}\n",
                       "\\usepackage{siunitx}\n",
                       "\\usepackage{rotating}\n",
                       "\\usepackage{natbib}\n",
                       "\\usepackage[flushleft]{threeparttable}",
                       "\\usepackage[a4paper, hmargin=0.5in,vmargin=0.5in]{geometry}",
                       "\\begin{document}",
                       "\n")
  
  bottom.header <- c("\n \\end{document}")
  
  if (headers == TRUE) write(top.header, file)
  
  if (!headers & !append) {
    ##Empty the text file
    write("", file)
  }
  
  ##Write the stargazer output to the file
  for (i in seq_along(starlist)) {
    
    write(paste0("%Tex File: ", getwd(), "/", file), file, append = TRUE)
    write(starlist[[i]], file, append = TRUE)
    write("\n\n", file, append = TRUE)
  }
  
  if (headers) {
    write(bottom.header, file, append = TRUE)
  }
  
  return(invisible(NULL))
}



## c:/Dropbox/Rpackages/starpolish/R/utils.R

##    Chandler Lutz
##    Questions/comments: cl.eco@cbs.dk
##    $Revisions:      1.0.0     $Date:  2016-12-21

##for some utility functions for the starpolish package:base

#' Check if stargazer output is in latex form
#'
#' @param star the \code{stargazer} output
is.latex <- function(star) grepl("tabular", star) %>% any

#' Check if stargazer output is in text form
#'
#' @param star the \code{stargazer} output
is.text <- function(star) grepl("==", star) %>% any

#' Get \code{stargazer} line numbers by section
#'
#' To get the start line numbers, main line numbers, and end line numbers
#' of \code{stargazer} output
#'
#' @param star the \code{stargazer} output
#' @param reg if the stargazer is a regression
#' @return a list with the line number for the \code{start.lines},
#' \code{main.lines}, and \code{end.lines} of the \code{stargazer}
#' output
get_star_line_numbers <- function(star, reg = TRUE, extra.rows=extra.rows) {
  
  latex <- is.latex(star)
  text <- is.text(star)
  
  ##Get the start and end of the table
  if (latex) {
    
    ##This uses that fact that \hlines in stargazer are symmetric
    hlines <- grep("hline", star)
    
    if (reg) {
      ##if the stargazer output is a regression
      ##remove if hlines has a element before or after it that is also
      ##an hline as the very start and end of the tables are both hlines.
      ##only keep the middle two elements of hlines
      # while(length(hlines) > 2)
      #   hlines <- hlines[c(-1, -length(hlines))]
      hlines<-c(hlines[2]-2, hlines[2]+3) #TK SOC changed this line for APSR
    } else {
      ##not a regression, only keep the last two elements of hlines
      hlines <- hlines[(length(hlines) - 1):length(hlines)]
    }
    
    
  } else if (text) {
    ##which lines only have dashes and no whitespace?
    ##these are the horizontal lines separating the sections
    hlines <- (grepl("---", star) & !grepl("\\s", star)) %>%
      which
  }
  
  
  ##The start, main ouput and the end lines
  start.lines <- 1:hlines[1]-1
  main.lines <- (hlines[1]):(hlines[2]+1+extra.rows) #TK steve adjusting on july 25 to capture the full sets of info per panel -- originnall ended in -1
  end.lines <- hlines[2]+extra.rows+2:length(star)
  
  return(list(start.lines = start.lines,
              main.lines = main.lines,
              end.lines = end.lines
  )
  )
}

#' get the star lines from \code{stargazer} output
#'
#' This function will return a list
#'
#' @param star the \code{stargazer} ouput
#' @param reg (logical) set to TRUE for a regression
#' @return a list with the \code{start.lines},
#' \code{main.lines}, and \code{end.lines} of the \code{stargazer}
#' output
get_star_lines <- function(star, reg, extra.rows) {
  
  star.line.numbers <- get_star_line_numbers(star, reg, extra.rows)
  
  star.lines <- list(start.lines = star[star.line.numbers$start.lines],
                     main.lines = star[star.line.numbers$main.lines],
                     end.lines = star[star.line.numbers$end.lines]
  )
  return(star.lines)
}

## c:/Dropbox/Rpackages/starpolish/R/star_cleaning_functions.R

##    Chandler Lutz
##    Questions/comments: cl.eco@cbs.dk
##    $Revisions:      1.0.0     $Date:  2016-12-21

##Extra functions for cleaning stargazer ouput

#' Insert column numbrers in a table
#'
#' Currently this only works for latex. This function is helpful when
#' creating a stargazer table from matrix output as stargazer does not
#' automatically use column numbers for matrices
#'
#' @param star the \code{stargazer} output
#' @param insert.after insert the column numbers after
#'     \code{inster.after}
#' @param skip.col.1 skip the first column? If \code{TRUE} no column
#'     number will be placed after the first column
#' @param add.space add space before the previous column? Defaults to \code{FALSE}
#' @param multicol if not \code{NULL}, multicolumn labels will be
#'     used. Options are "l" for left, "c" for center, and "r" for
#'     right. A character vector can be used for different alignments
#'     across different columns. If a single character is used, that
#'     alignment will be used for all elements in pattern. If a latex
#'     multicol is already applied by stargazer, \code{multicol} will
#'     be ignored for that variable.
#' @return an updated version of the stargazer table with column numbers
#' @examples
#' library(stargazer)
#' data(mtcars)
#' star.out <- stargazer(as.matrix(head(mtcars)))
#' print(star.out)
#' ##Insert column number using default values
#' star_add_column_numbers(star.out, insert.after = 10)
#' ##Do not skip the first column when creating column numbers
#' star_add_column_numbers(star.out, insert.after = 10, skip.col.1 = FALSE)
#' ##Add a space before the previous column
#' star_add_column_numbers(star.out, insert.after = 10, add.space = TRUE)
#' ##Use multicolumns in latex. Could also pass a vector of columns
#' star_add_column_numbers(star.out, insert.after = 10, multicol = "c")
#' ##Use multicolumn and don't skip the first column
#' star_add_column_numbers(star.out, insert.after = 10, skip.col.1 = FALSE, multicol = "c")
#' @export
star_add_column_numbers <- function(star, insert.after, skip.col.1 = TRUE, add.space = FALSE,
                                    multicol = NULL) {
  
  if (!is.latex(star))
    stop("star_add_column_numbers() currently only supported with latex")
  
  ##The number of columns
  num.cols <- star_ncol(star)
  
  ##If multicol is not null and has length 1, set it equal
  ##to the length of num.cols
  if (!is.null(multicol)) {
    if (length(multicol) == 1 && skip.col.1) {
      multicol <- rep(multicol, num.cols - 1)
    } else if (length(multicol) == 1) {
      multicol <- rep(multicol, num.cols)
    }
  }
  
  
  ##Get the first and last strings for use with multicolumn
  if (!is.null(multicol)) {
    ##Use multicolumns
    first.string <- paste0("\\multicolumn{1}{", multicol, "}{(")
    last.string <- paste0(")}")
  } else {
    ##No multicolumns
    first.string <- "("
    last.string <- ")"
  }
  
  if (skip.col.1) {
    ##if skip.col.1 is TRUE, skip the first column
    
    ##get the column numbers
    col.nums <- paste0(first.string, 1:(num.cols - 1), last.string, collapse = " & ")
    ##add the first & for the first row and the end of the latex column
    col.nums <- paste0(" & ", col.nums, " \\\\ ")
  } else {
    ##use a column number for the first column
    
    ##get the column numbers
    col.nums <- paste0(first.string, 1:num.cols, last.string, collapse = " & ")
    ##add the first & for the first row and the end of the latex column
    col.nums <- paste0(col.nums, " \\\\ ")
  }
  
  if (add.space) {
    ##Add the space as in the normal stargazer output
    col.nums <- paste0("\\\\[-1.8ex] ", col.nums)
  }
  
  return(star_insert_row(star, col.nums, insert.after = insert.after))
  
}


#' A function to replace asterisks with latex compatible values
#'
#' @param star the \code{stargazer} output
#' @return updated stargazer output with latex compaitble
#' asterisks
#' @export
star_asterisks <- function(star) {
  
  star <- gsub("(\\\\textasteriskcentered\\s?){3}", "$^{***}$", star)
  star <- gsub("(\\\\textasteriskcentered\\s?){2}", "$^{**}$", star)
  star <- gsub("(\\\\textasteriskcentered\\s?){1}", "$^*$", star)
  
  return(star)
}


#' Insert a row in a stargazer table
#'
#' @param star the \code{stargazer} output
#' @param string the string of text to insert into the table
#' @param insert.after insert \code{string} after
#'     \code{inster.after}. \code{insert.after} can be a vector, so
#'     you can insert multiple strings at one time. If
#'     \code{insert.after} has length 1, then all elements of
#'     \code{string} are insterted after \code{insert.after}.
#' @return the updated \code{stargazer} output
#' @examples
#' ## -- Regression Example -- ##
#' library(stargazer)
#' data(mtcars)
#' mod.mtcars.1 <- lm(mpg ~ hp + wt, mtcars)
#' mod.mtcars.2 <- lm(mpg ~ hp + wt + cyl, mtcars)
#' mod.mtcars.3 <- lm(hp ~ wt + cyl, mtcars)
#' ##latex example
#' star.out <- stargazer(mod.mtcars.1, mod.mtcars.2, mod.mtcars.3,
#'                       type = "latex")
#' print(star.out)
#' star_insert_row(star.out, "Controls? & No & No & No \\\\", insert.after = 27)
#' star_insert_row(star.out,
#'                c("Controls? & No & No & No \\\\",
#'                  "Linear Model? & Yes & Yes & Yes \\\\"),
#'                insert.after = c(27, 32))
#' @export
star_insert_row <- function(star, string, insert.after) {
  
  if (length(string) < length(insert.after)) {
    stop("Error: in star_insert_row() insert.after has more elements than string")
  }
  
  if (length(insert.after) == 1) {
    ##If the length of insert.after is 1, use the append function
    return(append(star, string, after = insert.after))
  }
  ##c(star[1:insert.after], string, star[(insert.after + 1):length(star)]))
  
  if (length(string) > length(insert.after)) {
    ##string has more elements than Insert after
    ##fill insert.after with its last element so its length
    ##matches string
    length.diff <- length(string) - length(insert.after)
    insert.after <- c(insert.after,
                      rep(insert.after[length(insert.after)], length.diff))
  }
  
  ##From http://stackoverflow.com/a/1495204/1317443
  id <- c(seq_along(star), insert.after + 0.5)
  star <- c(star, string)
  star <- star[order(id)]
  return(star)
}


#' get the number of stargazer columns
#'
#' @param star the \code{stargazer} output
#' @return the number of columns in the \code{stargazer} output
#' @examples
#' library(stargazer)
#' data(mtcars)
#' star.out <- stargazer(mtcars)
#' star_ncol(star.out)
#' @export
star_ncol <- function(star) {
  
  return(max(stringr::str_count(star, "&")) + 1)
}

#' A function to for scientific unit columns from the latex
#' \code{siunitx} package
#'
#' The latex \code{siunitx} package has to be loaded in the preamble.
#' See this answer on tex stackexchange:
#' \url{http://tex.stackexchange.com/a/2747} This function is useful
#' with \code{paste0} when updating column to work \code{siunitx} and
#' aligning decimals.
#'
#' @param table.format the latex \code{siunitx}. For example \code{3.2}
#'     is three integers and two decimals. \code{table.format} can be a
#'     string or numeric.
#' @param rep.times the number of times to repeat the given column
#' @export
star_si_col <- function(table.format, rep.times = 1) {
  out <- paste0("S[table-format=", table.format, "]")
  if (rep.times > 1) {
    out <- paste(rep(out, rep.times), collapse = "")
  }
  return(out)
}

#' Turn a latex table into a \code{sidewaystable} latex table
#'
#' @param star the \code{stargazer} output
#' @return the latex table turned sideways
#' @examples
#' library(stargazer)
#' data(mtcars)
#' star.out <- stargazer(mtcars)
#' star_sidewaystable(star.out)
#' @export
star_sidewaystable <- function(star) {
  star <- sub("begin\\{table\\}", "begin{sidewaystable}", star)
  star <- sub("end\\{table\\}", "end{sidewaystable}", star)
  return(star)
}